#!/usr/bin/perl -w
use lib './lib';
use strict;
use Socket;
use Chimera::CGI;
use IO::Poll qw(POLLIN POLLOUT POLLHUP POLLERR);
use Errno qw(EWOULDBLOCK);


$SIG{PIPE} = 'IGNORE';

my $host  = $ENV{'SERVER_NAME'} = shift || die("Usage: chimera.pl host [port]\n");
my $port  = $ENV{'SERVER_PORT'} = shift || 3092;
my $proto = getprotobyname('tcp') || die("getprotobyname() failed: $!");

socket(my $sock, AF_INET, SOCK_STREAM, $proto) or die("socket() failed: $!");
setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, 1) or die("can't set SO_REUSEADDR: $!");
my $pack_addr = inet_aton($host) or die("inet_aton() failed: $host");
my $sock_addr = sockaddr_in($port, $pack_addr);
bind($sock, $sock_addr) or die("bind() failed: $!");
listen($sock, SOMAXCONN) or die("listen() failed: $!");
my $poll = IO::Poll->new() or die("can't create IO::Poll object\n");
$poll->mask($sock => POLLIN|POLLOUT);

warn "Waiting for incoming connections on port $port...\n";

my %urls = ('/send' => \&url_send,
            '/chat' => \&url_chat);

my $users   = {};
my $clients = {};
my @history = ();

while(1) {
    $poll->poll();

    for my $handle ($poll->handles(POLLIN|POLLHUP|POLLERR)) {
        if ($handle eq $sock) {
            my $client_addr = accept(my $client, $sock) or die("accept() failed: $!");
            $poll->mask($client => POLLIN);
            $clients->{$client}{read_buf}  = '';

            my ($client_port, $client_ip) = sockaddr_in($client_addr);
            $clients->{$client}{ip}     = $ENV{'REMOTE_ADDR'} = inet_ntoa($client_ip);
            $clients->{$client}{port}   = $ENV{'REMOTE_PORT'} = $client_port;
            $clients->{$client}{host}   = gethostbyaddr($client_ip, AF_INET);
            $clients->{$client}{events} = {};
            debug('ANC', 'connect');
        } else {
            my $rc = sysread($handle, $clients->{$handle}{read_buf},
                             2048, length($clients->{$handle}{read_buf}));
            if (defined $rc) {
                if ($rc > 0) {
                    if ($clients->{$handle}{read_buf} =~ s/(.*?)\r\n\r\n(.*)//s) {
                        my $cgi = Chimera::CGI->new($1, $2);
                        if (defined $urls{$ENV{'PATH_INFO'}}) {
                            my $handler = $urls{$ENV{'PATH_INFO'}};
                            if (ref($handler) eq 'CODE') {
                                debug('CHR', "call of the handler for url '$ENV{PATH_INFO}'");
                                my $handler_result = $handler->($cgi, $clients->{$handle}{events}) || '';
                                $clients->{$handle}{write_buf} .= $cgi->header().
                                                                 $handler_result;
                                $poll->mask($handle => POLLOUT);
                            } else {
                                debug('IED', "the handler of a url '$ENV{PATH_INFO}' is not the reference to an sub", 1);
                            }
                        } else {
                            debug('404', "$ENV{'REQUEST_METHOD'} ".
                                         "$ENV{'PATH_INFO'} ".
                                         "$ENV{'SERVER_PROTOCOL'}");
                            disconnect($handle);
                        }
                    }
                } else {
                    debug('CBC', 'disconnect');
                    disconnect($handle);
                }
            } elsif ($! == EWOULDBLOCK) {
                die("sysread() failed: $!\n");
            }
        }
    }

    for my $handle ($poll->handles(POLLOUT|POLLERR)) {
        my $rc = syswrite($handle, $clients->{$handle}{write_buf});
        if (defined $rc) {
            if ($rc > 0) {
                substr($clients->{$handle}{write_buf}, 0, $rc) = '';
            } else {
                if (defined $clients->{$handle}{events}{after_write}) {
                    my $handler = $clients->{$handle}{events}{after_write};
                    if (ref($handler) eq 'CODE') {
                        $handler->($handle);
                    }
                } else {
                    debug('200', 'gf');
                    disconnect($handle);
                }
            }
        } elsif ($! == EWOULDBLOCK) {
        } else {
           # die("syswrite() failed: $!\n");
        }
    }

}

# codes:
#   IED - internal error of the developer;
#   ANC - the server has accepted new connection;
#   CBC - the client has broken off connection;
#   CHR - call handler of the request;
#   404 - the requested url was not found;
#   200 -

sub debug {
    my ($chr, $msg, $sys) = @_;

    syswrite(STDOUT, sprintf("[%3.3s] (%s) -> %s\n",
                             uc(defined $chr ? $chr : '?'),
                             defined $sys ?
                                 $ENV{'SERVER_NAME'}.':'.$ENV{'SERVER_PORT'} :
                                 $ENV{'REMOTE_ADDR'}.':'.$ENV{'REMOTE_PORT'},
                             $msg));
}

sub disconnect {
    my $client = shift;

    delete($clients->{$client});
    $poll->mask($client, 0);
    shutdown($client, 2);
}



sub url_send {
    my $cgi = shift;

    if ($ENV{'REQUEST_METHOD'} eq 'POST') {
        my $to   = $cgi->param('to');
        my $msg  = $cgi->param('msg');
        my $from = $cgi->param('from');

        foreach (keys %{$clients}) {
            $clients->{$_}{write_buf} .= '<div>('.localtime().') <b>'.$ENV{'REMOTE_ADDR'}.':</b> '.$msg.'</div>';
        }
    }

    return;
}

sub url_chat {
    my $cgi = shift;
    my $events = shift;

    if ($ENV{'REQUEST_METHOD'} eq 'GET') {
        my $id = $cgi->param('id') || 'test';
        if (defined $id) {
            $events->{after_write} = sub {};

            return '<html>'.
                   '<head>'.
                   '<title>Chimera</title>'.
                   '</head>'.
                   '<body>'.
                   '<h1>Welcome!!!</h1>'.
                   "\n"x1024;
        }
    }

    return;
}

